factor out maybeAddJSONField

Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project

diff --git a/Command/MetaData.hs b/Command/MetaData.hs
index d5a280ec4b17307e31bd9423aa7b2de0e240b8b5..e07e5e99f25ec0dc612d622af3a55b7baf593084 100644 (file)
--- a/Command/MetaData.hs
+++ b/Command/MetaData.hs
@@ -12,11 +12,10 @@ import Annex.MetaData
 import Annex.VectorClock
 import Logs.MetaData
 import Annex.WorkTree
-import Messages.JSON (JSONActionItem(..), AddJSONActionItemField(..))
 import Types.Messages
-import Utility.Aeson
 import Utility.SafeOutput
 import Limit
+import Messages.JSON (JSONActionItem(..), eitherDecode)
 
 import qualified Data.Set as S
 import qualified Data.Map as M
@@ -127,9 +126,7 @@ perform c o k = case getSet o of
 cleanup :: Key -> CommandCleanup
 cleanup k = do
        m <- getCurrentMetaData k
-       case toJSON' (AddJSONActionItemField "fields" m) of
-               Object o -> maybeShowJSON $ AesonObject o
-               _ -> noop
+       maybeAddJSONField "fields" m
        showLongNote $ UnquotedString $ unlines $ concatMap showmeta $
                map unwrapmeta (fromMetaData m)
        return True

diff --git a/Command/Reinject.hs b/Command/Reinject.hs
index 98b729a2877b3ddec130dc78aeada41d0db874f1..b414ef2ee2469fc1b9402dc5b0b15b473882bf90 100644 (file)
--- a/Command/Reinject.hs
+++ b/Command/Reinject.hs
@@ -18,8 +18,6 @@ import Utility.Metered
 import Annex.WorkTree
 import qualified Git
 import qualified Annex
-import Utility.Aeson
-import Messages.JSON (AddJSONActionItemField(..))
 
 cmd :: Command
 cmd = withAnnexOptions [backendOption, jsonOptions] $
@@ -98,9 +96,7 @@ notAnnexed src a =
 
 perform :: RawFilePath -> Key -> CommandPerform
 perform src key = do
-       case toJSON' (AddJSONActionItemField "key" (serializeKey key)) of
-               Object o -> maybeShowJSON $ AesonObject o
-               _ -> noop
+       maybeAddJSONField "key" (serializeKey key)
        ifM move
                ( next $ cleanup key
                , giveup "failed"

diff --git a/Command/Unused.hs b/Command/Unused.hs
index d78ada994a6ac4d4a1b72e8836d90a23f206d75a..544f0da327884867e6a842f835f39e4d801b4e4a 100644 (file)
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -35,7 +35,6 @@ import Annex.BloomFilter
 import qualified Database.Keys
 import Annex.InodeSentinal
 import Utility.Aeson
-import Messages.JSON (AddJSONActionItemField(..))
 
 import qualified Data.Map as M
 import qualified Data.Vector as V
@@ -115,11 +114,9 @@ check fileprefix msg a c = do
        let unusedlist = number c l
        unless (null l) $
                showLongNote $ UnquotedString $ msg unusedlist
-       let v = V.fromList $ map (\(n,  k) -> (show n, serializeKey k)) unusedlist
-       let f = (if null fileprefix then "unused" else fileprefix) ++ "-list"
-       case toJSON' (AddJSONActionItemField f v) of
-               Object o -> maybeShowJSON $ AesonObject o
-               _ -> noop
+       maybeAddJSONField
+               ((if null fileprefix then "unused" else fileprefix) ++ "-list")
+               (V.fromList $ map (\(n,  k) -> (show n, serializeKey k)) unusedlist)
        updateUnusedLog (toRawFilePath fileprefix) (M.fromList unusedlist)
        return $ c + length l
 

diff --git a/Messages.hs b/Messages.hs
index e2510b32e8974e447c5b6a370f6749d84c6cb31a..7d865b29d63174dfaca59979a55767e50397afb6 100644 (file)
--- a/Messages.hs
+++ b/Messages.hs
@@ -37,6 +37,7 @@ module Messages (
        JSON.JSONChunk(..),
        maybeShowJSON,
        maybeShowJSON',
+       maybeAddJSONField,
        showFullJSON,
        showCustom,
        showHeader,
@@ -227,6 +228,12 @@ maybeShowJSON v = void $ withMessageState $ bufferJSON (JSON.add v)
 maybeShowJSON' :: JSON.JSONBuilder -> Annex ()
 maybeShowJSON' v = void $ withMessageState $ bufferJSON v
 
+{- Adds a field to the current json object. -}
+maybeAddJSONField :: JSON.ToJSON' v => String -> v -> Annex ()
+maybeAddJSONField f v = case JSON.toJSON' (JSON.AddJSONActionItemField f v) of
+       JSON.Object o -> maybeShowJSON $ JSON.AesonObject o
+       _ -> noop
+
 {- Shows a complete JSON value, only when in json mode. -}
 showFullJSON :: JSON.JSONChunk v -> Annex Bool
 showFullJSON v = withMessageState $ bufferJSON (JSON.complete v)

diff --git a/Messages/JSON.hs b/Messages/JSON.hs
index 2347f24d459c186bb464a3eed4991d052e462baf..6c7830b68975faa183a1d22c8cc25d68abe13d26 100644 (file)
--- a/Messages/JSON.hs
+++ b/Messages/JSON.hs
@@ -12,7 +12,6 @@ module Messages.JSON (
        JSONChunk(..),
        emit,
        emit',
-       encode,
        none,
        start,
        startActionItem,
@@ -29,6 +28,7 @@ module Messages.JSON (
        ObjectMap(..),
        JSONActionItem(..),
        AddJSONActionItemField(..),
+       module Utility.Aeson,
 ) where
 
 import Control.Applicative

diff --git a/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn b/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn
index 2205eb5fe718257f0e4fee84c1717207392d4ccb..cda2671f9d052b3f270fe3dfab35850eae6025e8 100644 (file)
--- a/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn
+++ b/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn
@@ -45,7 +45,6 @@ Provisional list of commands that don't support --json and maybe should:
 * git-annex-initremote
 * git-annex-merge
 * git-annex-renameremote
-* git-annex-sync
 * git-annex-upgrade
 
 These commands could support json, but I punted:
@@ -113,3 +112,11 @@ These commands have been reviewed and should not support json:
   (no output that would be useful to a program using these. They enter a
   new branch and git branch will tell what it is.)
 * git-annex-inprogress (output is already machine readable)
+* git-annex-sync (while it would be pretty easy to support, it outputs
+  different types of messages depending on what remotes it syncs with and
+  what needs to be done. Eg, copy to remote, or export to remote, or import
+  from remote. Each would be a different format of json message, which
+  violates the principle that all git-annex json output should be
+  discoverable by simply running the command. And of course, everything it
+  does can be done by other commands, which can support json without having
+  that problem.)